home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE05 / CALLBAX / CHANGEU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-06  |  2.9 KB  |  106 lines
  1. unit Changeu;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;
  8.  
  9. const
  10.   wm_TableChanged = wm_User + 57;
  11.  
  12. type
  13.   TForm1 = class(TForm)
  14.     Table1: TTable;
  15.     DataSource1: TDataSource;
  16.     DBGrid1: TDBGrid;
  17.     procedure FormDestroy(Sender: TObject);
  18.     procedure FormCreate(Sender: TObject);
  19.   private
  20.     { Private declarations }
  21.     FOldCallBack: TCallBack;
  22.     FChangeFunctionThunk: TFarProc;
  23.   public
  24.     { Public declarations }
  25.     procedure WMTableChanged(var Msg: TMessage); message wm_TableChanged;
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. implementation
  32.  
  33. uses
  34.   DbiTypes, DbiProcs;
  35.  
  36. {$R *.DFM}
  37.  
  38. function FindPrevInstanceProc(Wnd: HWnd; UserData: Longint): Bool; export;
  39. var
  40.   WndClass, WndText: array[0..255] of char;
  41. begin
  42.   Result := True;
  43.   { Concentrate solely on our EXE }
  44.   if GetWindowWord(Wnd, gww_HInstance) = HPrevInst then
  45.   begin
  46.     GetClassName(Wnd, WndClass, Pred(SizeOf(WndClass)));
  47.     GetWindowText(Wnd, WndText, Succ(Length(Application.MainForm.Caption)));
  48.     { Normally first window will be Application's }
  49.     { But if the app started minimised, it will be the main form's }
  50.     if (StrPas(WndClass) = Application.ClassName) or
  51.        ((StrPas(WndText) = Application.MainForm.Caption) and
  52.         IsIconic(Wnd)) then
  53.     begin
  54.       { This technique is used by the VCL - post a messge }
  55.       { then bring the window to the top, before the message }
  56.       { gets processed }
  57.       PostMessage(Wnd, wm_SysCommand, sc_Restore, 0);
  58.       BringWindowToTop(Wnd);
  59.       Halt;
  60.     end;
  61.   end;
  62. end;
  63.  
  64. function ChangeFunction(ecbType: CBType; iClientData: Longint;
  65.   var CbInfo: Pointer): CBRType; export;
  66. begin
  67.   Result := cbrUseDef;
  68.   if ecbType = cbTableChanged then
  69.     PostMessage(Application.MainForm.Handle, wm_TableChanged, 0, iClientData);
  70.   with Form1.FOldCallBack do
  71.     if ChainedFunc <> nil then Result :=
  72.       pfDBICallBack(ChainedFunc)(cbTableChanged, Data, Buffer)
  73. end;
  74.  
  75. procedure ChangeFunctionThunk; assembler;
  76. asm
  77.   mov ax, seg @Data
  78.   { Bypass the smart callback instruction }
  79.   jmp ChangeFunction + 3
  80. end;
  81.  
  82. procedure TForm1.FormCreate(Sender: TObject);
  83. begin
  84.   if HPrevInst <> 0 then
  85.     EnumWindows(@FindPrevInstanceProc, 0);
  86.   FChangeFunctionThunk := @ChangeFunctionThunk;
  87.   with FOldCallBack do
  88.     DbiGetCallBack(nil, cbTableChanged, Data, BufLen, Buffer, @ChainedFunc);
  89.   DbiRegisterCallBack(Table1.Handle, cbTableChanged, Longint(Table1), 0, nil,
  90.     pfDbiCallback(FChangeFunctionThunk));
  91. end;
  92.  
  93. procedure TForm1.FormDestroy(Sender: TObject);
  94. begin
  95.   DbiRegisterCallBack(Table1.Handle, cbTableChanged, 0, 0, nil, nil);
  96. end;
  97.  
  98. procedure TForm1.WMTableChanged(var Msg: TMessage);
  99. begin
  100.   if MessageDlg(TTable(Msg.LParam).TableName + ' has changed - refresh?',
  101.      mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  102.     TTable(Msg.LParam).Refresh;
  103. end;
  104.  
  105. end.
  106.